home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / util / wb / Clipper_AWNP.lha / Clipper_AWNP / Clipper < prev    next >
Text File  |  2000-02-09  |  27KB  |  859 lines
  1. /* $VER: 4.4 (05/02/00)  by Bruce Steers */
  2. /*
  3. mailto:bsteers@btinternet.com
  4. http://www.btinternet.com/~bsteers/
  5. */
  6.  
  7. /*SIGNAL ON ERROR ; SIGNAL ON HALT ; SIGNAL ON FAILURE ; SIGNAL ON SYNTAX*/
  8.  
  9. OPTIONS RESULTS
  10.  
  11. HelpFlag=0
  12. seld=0
  13. ver='4.4' ; verdate='(05/02/00) 1.06pm'
  14.  
  15. hs=0
  16.  
  17. if ~show('l','rexxdossupport.library') then call addlib('rexxdossupport.library',0,-30,0)
  18. if ~show('l','rexxarplib.library') then call addlib('rexxarplib.library',0,-30,0)
  19. if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30,0);
  20.  
  21. ibase=showlist(l,'intuition.library',,a); call forbid; Ascr=next(ibase,56); screen=word(IMPORT(next(Ascr,26)),1); call permit
  22.  
  23. if ~exists('s:ClipPrefs') then if ~makedir('S:ClipPrefs') then exit(STDERR)
  24.  
  25. parse source . . progname .
  26.  
  27.  
  28. progpath =substr(progname,1,max(lastpos('/',progname),lastpos(':',progname)))
  29.  
  30. parse arg prefsfile
  31.  
  32. p=index(upper(prefsfile),'SCREEN')
  33. if p~=0 then do
  34. screen=substr(prefsfile,p+7)
  35. if p~=1 then prefsfile=substr(prefsfile,1,p-2); else; prefsfile=''
  36. end
  37.  
  38.  if prefsfile=="" then do
  39.  prefsfile='s:ClipPrefs/Clipper.cfg'
  40.  if ~open(ph,'awnpipe:tt/xi'progname'','R') then exit(1)
  41.  call readln(ph); call readln(ph); call readln(ph)
  42.   do while ~eof(ph)
  43.   ln=readln(ph)
  44.   if index(upper(ln),'CONFIG=')==1 then prefsfile=Substr(ln,8)
  45.   end
  46.  call close(ph)
  47.  end
  48.  
  49. guide='help:'language'/Clipper.guide';
  50. if ~exists(guide) then do; guide='help:Clipper.guide';
  51. if ~exists(guide) then do; guide='Clipper.guide';
  52. if ~exists(guide) then do; guide=progpath'Clipper.guide';
  53. if ~exists(guide) then guide=0; end; end; end
  54. guide_at='main'
  55.  
  56. call BuildStrings()
  57.  
  58. call loadprefs()
  59.  
  60.  do forever
  61.  reload=0
  62.  call makegui()
  63. eofl=0
  64.  
  65.  do while eofl==0
  66.  eofl=eof(pipe)
  67.   if ~eofl then do
  68.   call topipe('con')
  69.   parse value with in in1 in2 in3 in4 in5
  70.   in= readln(pipe)
  71.   parse var in in1 in2 in3 in4 in5 .
  72.    select
  73.     when in1='gadget' then call gadget()
  74.     when in1='menu' then call menu()
  75.     when in1='help' then if helpflag~=0 then call help()
  76.     when in1='iconify' then call topipe('id 0 s '64-(in2*32))
  77.     when in1='key' then call key()
  78.     otherwise nop
  79.    end
  80.   end
  81.  end
  82.  
  83.  IF pipe~=0 THEN call Close(pipe)
  84.  openp=0
  85.  if eofl~=-3 then call cleanexit
  86.  end
  87.  
  88. key:   /*say in*/
  89. select
  90. when in2==95 then do
  91. if guide==0 then return
  92. guide_at=word('main prefs',hs+1)
  93. address command 'run >nil: amigaguide 'guide' document 'guide_at''
  94. end
  95. when in2==69 then call cleanexit(0)
  96. when in2==147 then do ; address command 'run rx 'progname ;call cleanexit; end
  97. otherwise nop
  98. end
  99. return
  100.  
  101. hsgads:
  102.   if hs==0 then do
  103.   call writeln(pipe,'id 0 read'); windln=readln(pipe);
  104.   parse var windln wl wt ww wh .
  105.   end
  106. hs=(hs==0)
  107. call reopenwindow()
  108. return
  109.  
  110. menu:    /*say in*/
  111.  select
  112.   when in2==0 then do
  113.     select
  114.     when in3==0 then call req('Clipper',' Clipper 'ver' *n Bruce Steers *n 'verdate' *n *n bsteers@btinternet.com *n http://www.btinternet.com/~bsteers/ *n *n :^) *n ','_OK')
  115.     when in3==1 THEN HelpFlag=in5
  116.     /* --- bar ---*/
  117.     when in3==3 then call prefs(in4)
  118.     when in3==5 then call hsgads()
  119.     when in3==6 then call newfont()
  120.     otherwise call cleanexit(0)
  121.     end
  122.   end
  123.  
  124.  
  125.   otherwise do
  126.     select
  127.       when in3==0 then call insertTE('0')
  128.       when in3==1 then call insertTE('1')
  129.       when in3==2 then call insertTE('2')
  130.       when in3==3 then call insertTE('3')
  131.       when in3==4 then call insertTE('4')
  132.       when in3==5 then call insertTE('5')
  133.       when in3==6 then call insertTE('6')
  134.       when in3==7 then call insertTE('7')
  135.       when in3==8 then call insertTE('8')
  136.       when in3==9 then call insertTE('9')
  137.       when in3==10 then call insertTE('10')
  138.       when in3==11 then call insertTE('11')
  139.       when in3==12 then call insertTE('12')
  140.       when in3==13 then call insertTE('13')
  141.       when in3==14 then call insertTE('14')
  142.       when in3==15 then call insertTE('15')
  143.  
  144.       when in3==17 then call insertTE('')
  145.       when in3==18 then call insertTE('')
  146.       when in3==19 then call insertTE('')
  147.       when in3==20 then call insertTE('')
  148.       otherwise call insertTE('')
  149.     end
  150.   end
  151.  end
  152. return
  153.  
  154. insertTE:;
  155.  msgs.lstat.seld.text=''msgs.lstat.seld.text''arg(1)''
  156.  tt=nocom(msgs.lstat.seld.text)
  157.  tp=length(msgs.lstat.seld.text)
  158.  
  159.  call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'tt'"')
  160.  call topipe('id 'txts' gt "'tt'" s 'tp'')
  161. return
  162.  
  163. prefs: ;
  164.  if arg(1)<2 then; call loadprefs(arg(1)==0);
  165.   else do;
  166.   if arg(1)==5 then; call hsgads(); else; call saveprefs(arg(1)==4);
  167.   end;
  168. return
  169.  
  170. saveprefs:
  171.  
  172. if openp=="main" & hs==1 then call hsgads()
  173.  
  174. if arg(1)==1 then do
  175.  np=afile(freq,'Prefs to Save',prefsfile,1)
  176.  if np=="" then return
  177.  prefsfile=np ;
  178.  end
  179.  if ~open(ph,prefsfile,'W') then call cleanexit(SIGL)
  180. txt=';'Filepart(prefsfile)' 'ver' ('date("e")') @ 'time("c")
  181. call writeln(ph,txt)
  182.  
  183.  call writeln(ph,'-d'wl' 'wt' 'ww' 'wh' -fnt'font' -fsz'fsize' -w'warnclip' -l'lstat' -s'seld' -b'beep' -HV'bars'')
  184.  call writeln(ph,strip(list,,'"'))
  185.  
  186.   do l=1 to listem.0
  187.    do c=1 to msgs.l.0
  188.    call writeln(ph,''msgs.l.c.name'¿'msgs.l.c.text'')
  189.    end
  190.   if l~=listem.0 then call writeln(ph,'[¿]')
  191.   end
  192.  
  193.  call close(ph)
  194. return
  195.  
  196. loadprefs:
  197. if ~exists(prefsfile) then do; if index(prefsfile,':')==0 & index(prefsfile,'/')==0 then prefsfile='s:clipprefs/'prefsfile; end
  198. if ~exists(prefsfile) then do
  199. if req('Clipper by Bruce',locales(MSG_NoPrefs),locales(MSG_Default),locales(MSG_Abort) )==2 then call cleanexit
  200. call open(ph,prefsfile,'W')
  201.  call writeln(ph,';;'Filepart(prefsfile)' 'ver' ('date(e)') @ 'time(c)'' || '0A'X || '-d10 10 10 10')
  202.  call writeln(ph,'commands¿Internet¿HTML¿AWNPipe' || '0A'X || 'AWeb My Home¿run >nil: aweb3:aweb-II http://www.btinternet.com/~bsteers/' || '0A'X || 'get awnp ver¿version full file l:awnpipe-handler%n' || '0A'X || '[¿]' || '0A'X || 'MY e-mail¿Bruce Steers <bsteers@btinternet.com>' || '0A'X || 'MY URL¿http://www.btinternet.com/~bsteers/')
  203.  call writeln(ph,'[¿]' || '0A'X || 'Template¿<html>%n<head>%n<title>title</title>%n</head>%n%n<body>bgcolor="#FFFFFF">%n%n%n</body>%n</html>%n' || '0A'X || 'Font¿<font size="" color="">' || '0A'X || 'Image¿<img src="" border="0">' || '0A'X || 'Link¿<a href=""></a>')
  204.  call writeln(ph,'[¿]' || '0A'X || 'GUI Template¿call buildgui()%n do while ~eof(pipe)%n call topipe(''con'')%n in=readln(pipe)%n parse var in in1 in2 in3 in4 in5%n  select%n  when in1==''close'' then say ''bye bye''%n  otherwise say in%n  end%n end%nexit(0)%n%nbuildgui:%nif ~open(pipe,''awnpipe:noname/xc'') then exit(1)%ncall topipe(''"No Name" defg cs a h m'')%n')
  205.  call writeln(ph,'call topipe(''layout v b 5 gt "New Layout"'')%ncall topipe(''button gt "New Gadget"'')%ncall topipe(''button gt "Quit Gadget" c'')%ncall topipe(''le'')%ncall topipe(''open'')%nreturn%n%ntopipe:%nparse arg out%ncall writeln(pipe,out); res=readln(pipe)%nparse var res res1 res2 .%nif res1=''ok'' then return(res2)%nsay ''error from: ''out; say ''  responce: '' res; exit%n')
  206. call close(ph)
  207. end
  208.  
  209. if arg(1)==1 then do
  210.  np=afile(freq, locales(MSG_Load) locales(MSG_Prefs),prefsfile)
  211.  if np=="" then return
  212.  prefsfile=np ;
  213.  end
  214.  
  215. call open(ph,prefsfile)
  216.  
  217. ln=readln(ph)
  218. ln=readln(ph)
  219. if ln~="" then parse var ln '-d' wl wt ww wh . 0 ' -fnt' font ' -fsz' fsize . 0 ' -w' warnclip ' -l' lstat ' -s' seld ' -b' beep . 0 ' -HV' bars .; else ;call cleanexit(1)
  220. if wl=="" then wl='10'; if wt=="" then wt='10'; if ww=="" then ww='10'; if wh=="" then wh='10';
  221. if font=="" then font='topaz.font' ; if fsize=="" then fsize='8';
  222. if warnclip=="" then warnclip=20 ; if lstat=="" then lstat=1 ; if seld=="" then seld=0;
  223. if beep=="" then beep=0; if bars=="" then bars=3
  224.  
  225. ln=readln(ph)
  226.  if ln~="" then do;
  227.   list='"'ln'"'
  228.   p=1
  229.   do c=1 until p<0
  230.   p=index(ln,'¿')
  231.    if p~=0 then do
  232.    listem.0=c
  233.    listem.c=substr(ln,1,p-1)
  234.    ln=substr(ln,p+1)
  235.    end
  236.    else do; p=-5 ; listem.0=c ; listem.c=ln; end
  237.  
  238.   end
  239.  end
  240.  else; call cleanexit(20)
  241.  
  242. doing=1 ; p=1
  243.  do while ~eof(ph)
  244.  ln=readln(ph)
  245.   if ln~="" then do;
  246.   if ln=='[¿]' then do; doing=doing+1 ;p=1; end
  247.    else do;
  248.    parse var ln msgs.doing.p.name '¿' msgs.doing.p.text
  249.    msgs.doing.0=p;
  250.    p=p+1
  251.    end
  252.   end
  253.  end
  254.  
  255. call close(ph)
  256.  
  257. if openp=='main' then call reopenwindow()
  258. return
  259.  
  260. freshlist:
  261. call topipe('id 'lview' remn')
  262. call topipe('id 'lview' list 0')
  263.  do c=1 to msgs.lstat.0
  264.  num=topipe('id 'lview' addn gt "'nocom(msgs.lstat.c.name)'¿'nocom(msgs.lstat.c.text)'"')
  265.  msgs.lstat.c.node=num
  266.  bn.num=c
  267.  end
  268.  call topipe('id 'lview' list 1')
  269.  call topipe('id 'lview' s 0')
  270. in2=lview ; in5=''
  271. call gadget()
  272. return
  273.  
  274. gets: parse var in . . ret ; return(substr(ret,2))
  275.  
  276. nocom: ; nxt=arg(1) ;
  277. p=1;
  278. do while p~=0;
  279. p=index(nxt,'*',p)
  280. if P~=0 then do; nxt=insert('*',nxt,p-1);p=p+2; end;
  281. end;
  282. p=1;
  283. do while p~=0;
  284. p=index(nxt,'"',p);
  285. if P~=0 then do; nxt=insert('*',nxt,p-1);p=p+2; end;
  286. end;
  287. return nxt
  288.  
  289. makelist: list='"'; do y=1 to listem.0; list=''list''listem.y'¿'; end; list=''strip(list,,'¿')'"'; call topipe('id 'lstg' cl 'list' s 'lstat-1' ref');  call dispud(); return
  290.  
  291. dispud:
  292. pdis=(lstat==listem.0); call topipe('id 'dnpg' dis 'pdis'');
  293. pdis=(48==listem.0); call topipe('id 'addpg' dis 'pdis'');
  294. pdis=(lstat==1);call topipe('id 'uppg' dis 'pdis'');
  295. pdis=(listem.0==1)
  296. call topipe('id 'sortpg' dis 'pdis'');
  297. call topipe('id 'lstg' dis 'pdis'');
  298. call topipe('id 'delpg' dis 'pdis'');
  299. return
  300.  
  301. gadget:
  302. select
  303.     when in2==prfg then do;
  304.         select
  305.              when in3<=4 then do;
  306.              in3=in3+(in3>1);call prefs(in3);
  307.              end
  308.          when in3==5 then do; call newfont(); return; end
  309.          end;
  310.      end
  311.  when in2==alertg then warnclip=in3
  312.  when in2==beepg then beep=in3
  313.  when in2==barsg then do; bars=in3; call reopenwindow(); end
  314.  
  315.  when in2=nams then do; msgs.lstat.seld.name=gets(); call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'nocom(msgs.lstat.seld.text)'"'); end
  316.  when in2=txts then do; msgs.lstat.seld.text=gets(); call topipe('id 'cpat' gt "'nocom(msgs.lstat.seld.name)'¿'nocom(msgs.lstat.seld.text)'"'); end
  317.  when in2=addg then call addgad()
  318.  when in2=delg then call delgad()
  319.  when in2=upg then call movegad('U')
  320.  when in2=dng then call movegad('D')
  321.  when in2=pags then do; listem.lstat=gets(); call makelist(); end
  322.  when in2=addpg then call addpage()
  323.  when in2=delpg then call delpage()
  324.  when in2=uppg then call movepage('U')
  325.  when in2=dnpg then call movepage('D')
  326.  when in2=lstg then do;
  327.  lstat=in3+1;
  328.   if hs then do
  329.   call topipe('id 'pags' gt "'listem.lstat'" ref')
  330.   call dispud()
  331.   end
  332.  call freshlist();
  333.  end
  334.  when in2==sortpg then do
  335.   do c=1 to listem.0
  336.    if c~=listem.0 then do
  337.     do cc=c to listem.0
  338.      if upper(listem.c)>upper(listem.cc) then do;
  339.       select
  340.       when cc==lstat then lstat=c
  341.       when c==lstat then lstat=cc
  342.       otherwise nop
  343.       end
  344.      call swapp()
  345.      end
  346.     end
  347.    end
  348.   end
  349.  call makelist()
  350.  /*call freshlist()*/
  351.  end
  352.  
  353.  when in2==sortg then do
  354.   do c=1 to msgs.lstat.0
  355.    if c~=msgs.lstat.0 then do
  356.     do cc=c to msgs.lstat.0
  357.      if upper(msgs.lstat.c.name)>upper(msgs.lstat.cc.name) then; call swapm();
  358.     end
  359.    end
  360.   end
  361.  call freshlist()
  362.  end
  363.  
  364.  when in2=lview then do
  365.  if in5=="" then seld=0;
  366.   if in5=="" then do;
  367.    if hs then do
  368.    call topipe('id 'nams' gt "" dis 1 ref');
  369.    call topipe('id 'delg' dis 1');
  370.    dis=(2>msgs.lstat.0); call topipe('id 'sortg' dis 'dis'')
  371.    call topipe('id 'sortg' dis 'dis'');
  372.    call topipe('id 'upg' dis 1');
  373.    call topipe('id 'dng' dis 1');
  374.    end
  375.   call topipe('id 'txts' gt "" dis 1 ref');
  376.   call topipe('id 'tmen' dis 1');
  377.   return;
  378.   end;
  379.  
  380.   else; nseld=bn.in5
  381.   if nseld~=seld then; seld=nseld;
  382.   cpat=in5
  383.   nxt=msgs.lstat.seld.name;
  384.   dis=(seld==0)
  385.   call topipe('id 'txts' dis 'dis' gt "'nocom(msgs.lstat.seld.text)'" ref')
  386.   call topipe('id 'tmen' dis 'dis'');
  387.    if hs then do
  388.    call topipe('id 'nams' dis 'dis' gt "'nocom(msgs.lstat.seld.name)'" ref')
  389.    d2=dis|(msgs.lstat.0<2) ;call topipe('id 'delg' dis 'd2' ref')
  390.    dis=(seld=1); call topipe('id 'upg' dis 'dis' ref')
  391.    dis=(seld=msgs.lstat.0); call topipe('id 'dng' dis 'dis' ref')
  392.    dis=(2>msgs.lstat.0); call topipe('id 'sortg' dis 'dis'')
  393.    end
  394.    if in3==16 then do
  395.    if open(hh,'awnpipe:clip/C','W')==0 then call req( locales( MSG_Error ),locales( MSG_ClipError ),'_OK :-\')
  396.    call newlines(msgs.lstat.seld.text)
  397.     do c=1 to coms.0 ;
  398.     if c==coms.0 then call writech(hh,coms.c)
  399.     else; call writeln(hh,coms.c)
  400.     end
  401.    call close(hh)
  402.    if beep~=0 then call topipe('beep=1')
  403.    if warnclip~=0 then do
  404.    call topipe('id 0 s 264 gt "--> 'nocom(msgs.lstat.seld.name)'"')
  405.    call delay(warnclip)
  406.    call topipe('id 0 s 520 gt "Clipper => bsteers@btinternet.com"')
  407.    end
  408.   end
  409.  end
  410.  
  411.  otherwise nop /*say in*/
  412.  end
  413. return
  414.  
  415. newlines:
  416. p=0 ; txt=arg(1)
  417. p=1
  418.  
  419.  do xx=1 while p>0
  420.  p=index(upper(txt),'%N',1)
  421.   if p~=0 then do
  422.   coms.0=xx
  423.   coms.xx=substr(txt,1,p-1)
  424.   txt=substr(txt,p+2)
  425.   end
  426.  
  427.   else do
  428.   coms.0=xx
  429.   coms.xx=txt
  430.   p=-20
  431.   end
  432.  end
  433. return
  434.  
  435. swapp:
  436.        tmp=listem.c
  437.        tmpc.0=msgs.c.0
  438.   do y=1 to tmpc.0 ; tmpc.y.name=msgs.c.y.name; tmpc.y.text=msgs.c.y.text; end
  439.        msgs.c.0=msgs.cc.0
  440.   do y=1 to msgs.c.0 ; msgs.c.y.name=msgs.cc.y.name; msgs.c.y.text=msgs.cc.y.text; end
  441.        msgs.cc.0=tmpc.0
  442.   do y=1 to tmpc.0 ; msgs.cc.y.name=tmpc.y.name; msgs.cc.y.text=tmpc.y.text; end
  443.       listem.c=listem.cc
  444.       listem.cc=tmp
  445. return
  446.  
  447. movepage: ;
  448. if arg(1)='U' then cc=lstat-1; else; cc=lstat+1;
  449. c=lstat
  450. call swapp()
  451. lstat=cc ; call makelist()
  452. return
  453.  
  454. delpage: ;
  455.  np=listem.0 ; np=np-1 ; listem.0=np
  456.  do n=lstat to np
  457.   plus=n+1
  458.   listem.n=listem.plus
  459.   msgs.n.0=msgs.plus.0;
  460.   do y=1 to msgs.n.0; msgs.n.y.name=msgs.plus.y.name ; end
  461.  end
  462.  
  463. lstat=min(lstat,listem.0)
  464.  
  465. call makelist()
  466. call freshlist()
  467. call topipe('id 'pags' gt "'listem.lstat'" ref')
  468. return
  469.  
  470. makegui:
  471. call open(pipe,"awnpipe:Clipper/xc")
  472.  
  473. call topipe('"Clipper bsteers@btinternet.com" v left 'wl' top 'wt' width 'ww' height 'wh' sk st "Clipper By Bruce Steers 'ver' 'verdate'" m h sc="¿" defg ig it "Clipper.Zzz" ii "'progname'" a ps "'screen'"')
  474.  
  475. call writeln(pipe,'TextAttr gt "'font'" defn 'fsize'');tmp=readln(pipe); parse var tmp . fontid fontA .
  476.  
  477. freq=topipe('getfile font 'fontid' ua')
  478. hstxt = locales(MSG_Show)' 'locales(MSG_Hide)
  479. hstxt = word(hstxt,hs+1) locales(MSG_Gadgets)
  480. call topipe('menu gt "'locales(MSG_Main)'¿@?'locales(MSG_About)'¿@H^%'locales(MSG_Bubble)'¿-¿'locales(MSG_Prefs)'¿$@L'locales(MSG_Load)'¿$@R'locales(MSG_Reload)'¿$-¿$@S'locales(MSG_Save)'¿$@A'locales(MSG_Save)' _'locales(MSG_As)'¿-¿@E'hstxt'¿@F'locales(MSG_Font)'¿-¿@Q'locales(MSG_Quit)'"')
  481. col=locales(MSG_Colour)
  482. tmen=topipe('menu gt "` 'locales(MSG_Style)'¿'col' 0¿'col' 1¿'col' 2¿'col' 3¿'col' 4¿'col' 5¿'col' 6¿'col' 7¿'col' 8¿'col' 9¿'col' 10¿'col' 11¿'col' 12¿'col' 13¿'col' 14¿'col' 15¿-¿'locales(MSG_Bold)'¿'locales(MSG_Underline)'¿'locales(MSG_Reverse)'¿'locales(MSG_Reset)'¿'locales(MSG_Beep)'"')
  483.  
  484. call topipe('layout b 0 font 'fontid'')
  485. fntreq=topipe('getfont font 'fontid' maxn 15 ua')
  486.  
  487.   vhb=''
  488.   if bars==1 | bars==3 THEN vhb=' v'
  489.   if bars==2 | bars==3 THEN vhb=vhb' h'
  490.  
  491. lview=topipe('listbrowser lbl "'locales(MSG_Name)'¿'locales(MSG_TexttoCopy)'"'vhb' a')
  492.  
  493. do yy=1 to msgs.lstat.0
  494. num=topipe('browsernode gt "'nocom(msgs.lstat.yy.name)'¿'nocom(msgs.lstat.yy.text)'"')
  495. msgs.lstat.yy.node=num
  496. bn.num=yy
  497. end
  498. call topipe('le')
  499.  call topipe('layout font 'fontid' b 0 cj v weih 0')
  500.  
  501.   call topipe('layout font 'fontid' sw b 0 weih 0')
  502.   dis=(listem.0<2)
  503.   lstg=topipe('chooser tc maxn 48 pu cl 'list' s 'lstat-1' dis 'dis'') ;
  504.  
  505.   prfg=topipe('chooser font 'fontid' tc weiw 0 cl "'locales(MSG_Load)' 'locales(MSG_Prefs)'¿'locales(MSG_Reload)'¿'locales(MSG_Save)' 'locales(MSG_Prefs)'¿'locales(MSG_Save)' 'locales(MSG_As)'¿'hstxt'¿'locales(MSG_Font)'"') ;
  506.   call topipe('le')
  507.  
  508.  if hs==1 then do
  509.  pags=topipe('string tc lj gt "'listem.lstat'"') ;
  510.   call topipe('layout font 'fontid' b 0 weih 0')
  511.   addpg=topipe('button tc gt "+"')
  512.   delpg=topipe('button tc gt "-"')
  513.   sortpg=topipe('button tc gt "S"')
  514.   pdis=(lstat==1)
  515.   uppg=topipe('button weiw 0 tc ab 5 dis 'pdis'')
  516.   pdis=(lstat==listem.0)
  517.   dnpg=topipe('button weiw 0 tc ab 6 dis 'pdis'')
  518.   call topipe('le')
  519.  nams=topipe('string tc lj dis 1') ;
  520.  end
  521.  
  522.   call topipe('layout font 'fontid' b 0 v')
  523.   txts=topipe('string tc maxc 1998 lj dis 1')
  524.  
  525.   if hs==1 then do
  526.    call topipe('layout font 'fontid' cj b 0 weih 0')
  527.    addg=topipe('button tc gt "+"')
  528.    delg=topipe('button tc gt "-" dis 1')
  529.    sortg=topipe('button tc gt "S"')
  530.    upg=topipe('button tc ab 5 weiw 0 dis 1')
  531.    dng=topipe('button tc ab 6 weiw 0 dis 1')
  532.    call topipe('le')
  533.  
  534.    call topipe('layout font 'fontid' b 0 cj so si weih 0')
  535.    call topipe('label gt "*n 'locales(MSG_Alert)' "')
  536.    alertg=topipe('integer tc a minn 0 maxn 100 minc 3 defn 'warnclip'')
  537.    call topipe('space')
  538.   beepg=topipe('Checkbox rj gt "'locales(MSG_Beep)'" s 'beep'')
  539.    call topipe('le')
  540.   barsg=topipe('Chooser tc pu cl "'locales(MSG_Bars)'" s 'bars'')
  541.   end
  542.  
  543.  call topipe('le')
  544.  
  545. call topipe('open')
  546. openp='main'
  547.  
  548. if seld~=0 then do
  549. in2=lview ; in3=16 ; in5=msgs.lstat.seld.node
  550. call topipe('id 'lview' s 'msgs.lstat.seld.node'')
  551. call gadget()
  552. end
  553. return
  554.  
  555. reopenwindow: ; call writeln(pipe,'close'); call readln(pipe) ; eofl=-3 ; return
  556.  
  557. topipe: ; parse arg out; call writeln(pipe,out); res=readln(pipe); parse var res res1 res2 .; if res1='ok' then return(res2);say locales(MSG_Error)' from: 'out; say '  <--: ' res; IF pipe~=0 THEN call close(pipe); call cleanexit
  558.  
  559. req:
  560. if openp=='main' then call topipe('id 0 s 256')
  561.  parse arg rbar,rtxt,rg1,rg2,rg3,rg4,rg5,rg6,rg7,rg8 .; if rf~=0 then call close(rf); call open(rf,'awnpipe:ClipperReq/xc'); call writeln(rf,'"'rbar'" v it "Clipper" sw dg db a ps "'screen'"');
  562. call writeln(rf,'space');; call writeln(rf,'layout b 5'); call writeln(rf,'space'); call writeln(rf,'label so weih 5 weiw 10 gt "*n*n'rtxt'"'); call writeln(rf,'space'); call writeln(rf,'le'); call writeln(rf,'layout b 0 si so');
  563. if rg1~="" then call writeln(rf,'button gt "'rg1'" close');if rg2~="" then call writeln(rf,'button gt "'rg2'" close');if rg3~="" then call writeln(rf,'button gt "'rg3'" close'); if rg4~="" then call writeln(rf,'button gt "'rg4'" close');
  564. if rg5~="" then call writeln(rf,'button gt "'rg5'" close');if rg6~="" then call writeln(rf,'button gt "'rg6'" close');if rg7~="" then call writeln(rf,'button gt "'rg7'" close');if rg8~="" then call writeln(rf,'button gt "'rg8'" close');
  565. call writeln(rf,'le'); call writeln(rf,'open');call readln(rf); do while ~eof(rf); rn=readln(rf); parse var rn rn1 rn2 rn3 rn4 rn5 .; if rn1=='gadget' then do; if openp=='main' then call topipe('id 0 s 512');return(rn2-2); end; end;if openp=='main' then call topipe('id 0 s 512'); return(0)
  566.  
  567. delgad:
  568. if msgs.lstat.0==1 then return
  569. listnum=msgs.lstat.0
  570. do n=seld to msgs.lstat.0
  571.  if n<listnum then do
  572.  plus=n+1
  573.  msgs.lstat.n.name=msgs.lstat.plus.name
  574.  msgs.lstat.n.text=msgs.lstat.plus.text
  575.  msgs.lstat.n.node=msgs.lstat.plus.node
  576.  nn=msgs.lstat.n.node; m=bn.nn ; bn.nn=m-1
  577.  end
  578. end
  579. listnum=listnum-1
  580.  
  581. call topipe('id 'cpat' remn')
  582. in2=lview
  583. msgs.lstat.0=listnum
  584. seld=min(seld,msgs.lstat.0)
  585.  if msgs.lstat.0~=0 then do
  586.  in5=msgs.lstat.seld.node
  587.  call topipe('id 'lview' s 'in5'')
  588.  end
  589.  else do;
  590.  in5=''
  591.  call topipe('id 'lview' s 0')
  592.  end
  593.  
  594. call gadget()
  595. return
  596.  
  597. swapm:
  598. tn=msgs.lstat.cc.name
  599. tt=msgs.lstat.cc.text
  600. msgs.lstat.cc.name=msgs.lstat.c.name
  601. msgs.lstat.cc.text=msgs.lstat.c.text
  602. msgs.lstat.c.name=tn
  603. msgs.lstat.c.text=tt
  604. return
  605.  
  606. movegad: ;
  607. if arg(1)='U' then cc=seld-1; else; cc=seld+1;
  608. c=seld
  609. call swapm()
  610. in5=msgs.lstat.cc.node
  611. call topipe('id 'lview' list 0')
  612.  
  613. call topipe('id 'in5' gt "'nocom(msgs.lstat.cc.name)'¿'nocom(msgs.lstat.cc.text)'"')
  614. call topipe('id 'msgs.lstat.c.node' gt "'nocom(msgs.lstat.c.name)'¿'nocom(msgs.lstat.c.text)'"')
  615.  
  616. call topipe('id 'lview' list 1')
  617. call topipe('id 'lview' s 'in5'')
  618. seld=cc ; in2=lview
  619. call gadget()
  620. return
  621.  
  622. addgad:
  623.  
  624. next=1+msgs.lstat.0
  625. msgs.lstat.0=next
  626. msgs.lstat.next.name='<'locales(MSG_Name)'>'
  627. msgs.lstat.next.text='<'locales(MSG_Text)'>'
  628. in5=topipe('id 'lview' addn gt "<'locales(MSG_Name)'>¿<'locales(MSG_Text)'>"')
  629. msgs.lstat.next.node=in5
  630. bn.in5=next
  631. call topipe('id 'lview' s 'in5'')
  632. seld=next
  633. in2=lview
  634. call gadget()
  635. return
  636.  
  637. addpage:
  638. lstat=1+listem.0; listem.0=lstat
  639. listem.lstat='<'locales(MSG_Page) listem.0'>'
  640. list='"'Strip(list,,'"')'¿'locales(MSG_Page) listem.0'"'
  641. call topipe('id 'lstg' cl 'list' s 'lstat-1'')
  642. in2=lstg ; in3=lstat-1
  643. msgs.lstat.0=0
  644. call gadget()
  645. call addgad()
  646. return
  647.  
  648. help:
  649.  
  650. SELECT
  651.  WHEN in2==lview then call ShowHelp(locales(MSG_lviewH))
  652.  WHEN in2==txts then call ShowHelp(locales(MSG_tstsH))
  653.  WHEN in2==lstg then call ShowHelp(locales(MSG_lstgH))
  654.  WHEN in2==prfg then call ShowHelp(locales(MSG_prfgH))
  655.  WHEN hs & in2==nams then call ShowHelp(locales(MSG_namsH))
  656.  WHEN hs & in2==addg then call ShowHelp(locales(MSG_addgH))
  657.  WHEN hs & in2==delg then call ShowHelp(locales(MSG_delgH))
  658.  WHEN hs & in2==sortg then call ShowHelp(locales(MSG_sortgH))
  659.  WHEN hs & in2==upg then call ShowHelp(locales(MSG_upgH))
  660.  WHEN hs & in2==dng then call ShowHelp(locales(MSG_dngH))
  661.  WHEN hs & in2==pags then call ShowHelp(locales(MSG_pagsH))
  662.  WHEN hs & in2==addpg then call ShowHelp(locales(MSG_addpgH))
  663.  WHEN hs & in2==delpg then call ShowHelp(locales(MSG_delpgH))
  664.  WHEN hs & in2==sortpg then call ShowHelp(locales(MSG_sortpgH))
  665.  WHEN hs & in2==uppg then call ShowHelp(locales(MSG_uppgH))
  666.  WHEN hs & in2==dnpg then call ShowHelp(locales(MSG_dnpgH))
  667.  WHEN hs & in2==alertg then call ShowHelp(locales(MSG_alertgH))
  668.  WHEN hs & in2==beepg then call ShowHelp(locales(MSG_beepgH))
  669.  WHEN hs & in2==barsg then call ShowHelp(locales(MSG_barsH))
  670. OTHERWISE call topipe('bubble')
  671.  
  672.  END
  673. return
  674.  
  675. ActiveMouseXY:   /*--------Gets MouseX and MouseY of Active Window----------*/
  676. call forbid;
  677. mousey=c2d(IMPORT(offset(Ascr,16),2)) ; mousex=c2d(IMPORT(offset(Ascr,18),2))
  678. call permit
  679. return
  680.  
  681. showHelp:
  682. call ActiveMouseXY()
  683.  
  684. parse arg arg1 '|' arg2 ; arg2=strip(arg2)
  685.  
  686. call topipe('bubble left 'mousex' top 'mousey' gt " -'arg1'- *n *n 'arg2' "')
  687. return(0)
  688.  
  689. afile: PROCEDURE
  690. parse arg g,t,f,s .; if t=="" then t='Clipper';
  691. if f=="" then f=prefsfile; if s=="" then s=0
  692. call topipe('id 'g' fn "'f'" save 's'')
  693. call writeln(pipe,'id 'g' gt "'t'" s 1'); ret=readln(pipe)
  694. parse var ret . ret fl; fl=strip(strip(fl),,'"')
  695. if ret==0 then return ''
  696. return(fl)
  697.  
  698. newfont:
  699.  call writeln(pipe,'id 'fntreq' s 0')
  700.  ln=readln(pipe)
  701.  parse var ln r fn fz .
  702.  if r==0|fs=='no' then return
  703.  if fn==font&fz==fsize then return
  704.  font=fn; fsize=fz
  705.  call reopenwindow()
  706. return
  707.  
  708.  
  709. /*  Read default strings, open locale.library and catalog
  710.  
  711. Thanks to Nils Goers for letting me use this code from his WB tool T.H.E
  712. */
  713.  
  714. BuildStrings:
  715.  
  716. CALL BuildInLanguage()            /* install build-in language */
  717.  
  718. IF ~SHOW('l','locale.library') THEN CALL ADDLIB('locale.library',0,-30,0)
  719.  
  720. IF SHOW('l','locale.library') THEN DO
  721.     id='req'pragma('id')                /* get current language */
  722.     address command 'rxset' id '`echo $language`'
  723.     language=getclip(id)
  724.     call setclip(id,'')
  725.  
  726.    IF language ~= '' THEN DO
  727.     catalog = OPENCATALOG(progpath'catalogs/'language'/Clipper.catalog','english',0)
  728.         IF catalog = 0 THEN
  729.         catalog = OPENCATALOG(progpath'Clipper.catalog','english',0)
  730.    END
  731.  
  732.    IF catalog = 0 THEN
  733.     catalog = OPENCATALOG('Clipper.catalog','english',0)
  734. END
  735. RETURN
  736.  
  737. locales:
  738.  
  739.    PARSE ARG stringnumber
  740.  
  741.    IF catalog ~= 0 THEN
  742.       RETURN(GETCATALOGSTR(catalog,stringnumber,strings.stringnumber))
  743.    ELSE
  744.       RETURN(strings.stringnumber)
  745.  
  746. BuildInLanguage:
  747. /*
  748. ** $VER: Clipper 1.0 (30.01.00)
  749. */
  750.  
  751. MSG_NoPrefs   = 0
  752. MSG_Default   = 1
  753. MSG_Abort     = 2
  754. MSG_Load      = 3
  755. MSG_ReLoad    = 4
  756. MSG_Save      = 5
  757. MSG_As        = 6
  758. MSG_Prefs     = 7
  759. MSG_ClipError = 8
  760. MSG_Error     = 9
  761. MSG_About     = 10
  762. MSG_Main      = 11
  763. MSG_Bubble    = 12
  764. MSG_Font      = 13
  765. MSG_Style     = 14
  766. MSG_Colour    = 15
  767. MSG_Bold      = 16
  768. MSG_Underline = 17
  769. MSG_Reverse   = 18
  770. MSG_Reset     = 19
  771. MSG_Beep      = 20
  772. MSG_Name      = 21
  773. MSG_TexttoCopy= 22
  774. MSG_Show      = 23
  775. MSG_Hide      = 24
  776. MSG_Gadgets   = 25
  777. MSG_Alert     = 26
  778. MSG_Quit      = 27
  779. MSG_lviewH    = 28
  780. MSG_tstsH     = 29
  781. MSG_lstgH     = 30
  782. MSG_prfgH     = 31
  783. MSG_namsH     = 32
  784. MSG_addgH     = 33
  785. MSG_delgH     = 34
  786. MSG_sortgH    = 35
  787. MSG_upgH      = 36
  788. MSG_dngH      = 37
  789. MSG_pagsH     = 38
  790. MSG_addpgH    = 39
  791. MSG_delpgH    = 40
  792. MSG_sortpgH   = 41
  793. MSG_uppgH     = 42
  794. MSG_dnpgH     = 43
  795. MSG_alertgH   = 44
  796. MSG_beepgH    = 45
  797. MSG_bars      = 46
  798. MSG_barsH     = 47
  799.  
  800. strings.0  = 'No Prefsfile *n :-\ *n *n What Shall i do ?'
  801. strings.1  = 'Default'
  802. strings.2  = 'Abort'
  803. strings.3  = 'Load'
  804. strings.4  = 'Reload'
  805. strings.5  = 'Save'
  806. strings.6  = 'As'
  807. strings.7  = 'Prefs'
  808. strings.8  = 'ERROR OPENING CLIPBOARD'
  809. strings.9  = 'Error'
  810. strings.10 = 'About'
  811. strings.11 = 'Main'
  812. strings.12 = 'Bubble Help'
  813. strings.13 = 'Change Font'
  814. strings.14 = 'Append TextInput Style'
  815. strings.15 = 'Colour'
  816. strings.16 = 'Bold'
  817. strings.17 = 'Underline'
  818. strings.18 = 'Reverse'
  819. strings.19 = 'Reset'
  820. strings.20 = 'Beep'
  821. strings.21 = 'Name'
  822. strings.22 = 'Text to Copy'
  823. strings.23 = 'Show'
  824. strings.24 = 'Hide'
  825. strings.25 = 'Gadgets'
  826. strings.26 = 'Alert'
  827. strings.27 = 'Quit'
  828. strings.28 = 'Main List|Double Click An Item to *n send to the clipboard'
  829. strings.29 = 'Texts|Change the text *n sent to ClipBoard'
  830. strings.30 = 'Pages Gadget|Change Current Page'
  831. strings.31 = 'Prefs Gadget|Alter Current Settings'
  832. strings.32 = 'Name String|Change the Name *n of Selected Text'
  833. strings.33 = 'Add Text|Add a New Text *n to the list'
  834. strings.34 = 'Delete Text|Delete Selected Text *n from the list'
  835. strings.35 = 'Sort Texts|Sort all Texts in *n this list by name'
  836. strings.36 = 'Text UP|Move Selected Text *n UP'
  837. strings.37 = 'Text DOWN|Move Selected Text *n DOWN'
  838. strings.38 = 'Page Name|Change the Name *n of this Page'
  839. strings.39 = 'Add Pages|Add a New Page to *n the Chooser Gadget'
  840. strings.40 = 'Delete Pages|Delete Selected Page *n from the Chooser Gadget'
  841. strings.41 = 'Sort Pages|Sort Page Names in *n the Chooser Gadget'
  842. strings.42 = 'Page UP|Move Page UP in *n the Chooser Gadget'
  843. strings.43 = 'page Down|Move Page DOWN *n in the Chooser Gadget'
  844. strings.44 = 'Notify with Busy|Time in Ticks (50/second) *n Pointer is Busy when *n Sending Clip (0=none)'
  845. strings.45 = 'Notify with Beep|Beep when sending Clip'
  846. strings.46 = 'No Bars¿Verti Bars¿Horiz Bars¿Both Bars'
  847. strings.47 = 'List Bars|Mode for Seperators *n in main list'
  848. RETURN
  849.  
  850. ERROR: IF (RC>0)&(RC~='RC') THEN DO; Say ERROR RC':' ErrorText(RC); RC= ; call cleanexit(RC); END
  851. SYNTAX: IF (RC>0)&(RC~='RC') THEN DO; Say SYNTAX RC':' ErrorText(RC) RESULT; RC= ; call cleanexit(RC); END
  852. HALT: IF (RC>0)&(RC~='RC') THEN DO; Say 'HALT : Interrupt call!'; RC= ; call cleanexit(RC); END
  853. FAILURE: IF (RC>0)&(RC~='RC') THEN DO; Say 'FAILURE :' RC; RC= ; call cleanexit(RC); END
  854.  
  855. cleanexit:
  856. call CLOSECATALOG(catalog)
  857. if arg(1)~="" then Exit(arg(1)) ; else; exit
  858.  
  859.